home *** CD-ROM | disk | FTP | other *** search
/ Belgian Amiga Club - ADF Collection / BS1 part 26.zip / BS1 part 26 / AMOS compiler.adf / Examples / 3d_cube.AMOS / 3d_cube.amosSourceCode
AMOS Source Code  |  1991-06-13  |  4KB  |  193 lines
  1. '
  2. '
  3. ' 3d Cube Demo Showing Speed Of Compiled Calculations. 
  4. ' (c) Europress Software Ltd.
  5. '
  6. ' By Gary Symons B.Sc. 
  7. '
  8. '
  9. Set Buffer 80
  10. '
  11. Hide 
  12. '
  13. Dim _COS(360),_SIN(360)
  14. '
  15. Degree 
  16. For I=0 To 359
  17.    _COS(I)=Cos(I)*4096
  18.    _SIN(I)=Sin(I)*4096
  19. Next I
  20. '
  21. Gosub CREATE_OBJECT
  22. '
  23. Screen Open 0,640,200,2,Hires
  24. Curs Off : Colour 1,$FFF
  25. Locate 0,16
  26. Print : Centre "3D Cube By Gary Symons."
  27. Print : Centre "-Controls-"
  28. Print 
  29. Print : Centre "Left mouse key - Diminish"
  30. Print : Centre "Right mouse key - Zoom"
  31. Print : Centre "Arrows - Up Down Left & Right"
  32. Print : Centre "7(Home) on key pad rotate about y"
  33. Print : Centre "3(PgDn) on key pad rotate about x"
  34. Print : Centre "9(pgUp) on key pad rotate about z"
  35. CX=320 : CY=100
  36. Global CX,CY,I,A,B
  37. '
  38. Gr Writing 2 : Wait Vbl 
  39. Gosub SET_SCREEN
  40. Double Buffer : Update Off : Autoback 0
  41. A=0
  42. B=0
  43. OA1=A : OB1=B : OI1=I : OANX1=ANX : OANY1=ANY : OANZ1=ANZ
  44. X=OA1 : Y=OB1 : Z=OI1 : AX=OANX1 : AY=OANY1 : AZ=OANZ1 : Gosub OBJECT
  45. Screen Swap : Wait Vbl 
  46. OA2=A : OB2=B : OI2=I : OANX2=ANX : OANY2=ANY : OANZ2=ANZ
  47. X=OA2 : Y=OB2 : Z=OI2 : AX=OANX2 : AY=OANY2 : AZ=OANZ2 : Gosub OBJECT
  48. Screen Swap : Wait Vbl 
  49. KR=0
  50. Do 
  51.    X=OA1 : Y=OB1 : Z=OI1 : AX=OANX1 : AY=OANY1 : AZ=OANZ1
  52.    Gosub OBJECT
  53.    Gosub MOVE_OBJECT
  54.    OA1=A : OB1=B : OI1=I : OANX1=ANX : OANY1=ANY : OANZ1=ANZ
  55.    X=OA1 : Y=OB1 : Z=OI1 : AX=OANX1 : AY=OANY1 : AZ=OANZ1
  56.    Gosub OBJECT
  57.    Screen Swap : Wait Vbl 
  58.    '  
  59.    X=OA2 : Y=OB2 : Z=OI2 : AX=OANX2 : AY=OANY2 : AZ=OANZ2
  60.    Gosub OBJECT
  61.    Gosub MOVE_OBJECT
  62.    OA2=A : OB2=B : OI2=I : OANX2=ANX : OANY2=ANY : OANZ2=ANZ
  63.    X=OA2 : Y=OB2 : Z=OI2 : AX=OANX2 : AY=OANY2 : AZ=OANZ2
  64.    Gosub OBJECT
  65.    Screen Swap : Wait Vbl 
  66. Loop 
  67. '
  68. MOVE_OBJECT:
  69. Add ANX,XA,0 To 359
  70. Add ANY,YA,0 To 359
  71. Add ANZ,ZA,0 To 359
  72. If KR=0
  73.    If Key State($1F) : Add XA,1,0 To 359 : KR=1 : End If 
  74.    If Key State($3D) : Add YA,1,0 To 359 : KR=1 : End If 
  75.    If Key State($3F) : Add ZA,1,0 To 359 : KR=1 : End If 
  76. Else 
  77.    If(Key State($1F)=0 and(Key State($3D)=0) and(Key State($3F)=0))
  78.       KR=0
  79.    End If 
  80. End If 
  81. If Key State($4F) Then Add A,10
  82. If Key State($4E) Then Add A,-10
  83. If Key State($4D) Then Add B,10
  84. If Key State($4C) Then Add B,-10
  85. If Mouse Key=1 Then Add I,10
  86. If Mouse Key=2 Then Add I,-10
  87. If I<230 Then I=230
  88. Return 
  89. '
  90. OBJECT:
  91. Q=Varptr(OBJECT$)
  92. C=Leek(Q)
  93. Add Q,4
  94. While C<>0
  95.    RX=Leek(Q)
  96.    Add Q,4
  97.    RY=Leek(Q)
  98.    Add Q,4
  99.    RZ=Leek(Q)
  100.    Add Q,4
  101.    CS=_COS(AX)
  102.    SN=_SIN(AX)
  103.    '
  104.    RY2=(RY*CS+RZ*SN)/4096
  105.    RZ=(RZ*CS-RY*SN)/4096
  106.    RY=RY2
  107.    '
  108.    CS=_COS(AY)
  109.    SN=_SIN(AY)
  110.    RX2=(RX*CS+RZ*SN)/4096
  111.    RZ=(RZ*CS-RX*SN)/4096
  112.    RX=RX2
  113.    '
  114.    CS=_COS(AZ)
  115.    SN=_SIN(AZ)
  116.    RY2=(RY*CS+RX*SN)/4096
  117.    RX=(RX*CS-RY*SN)/4096
  118.    RY=RY2
  119.    '
  120.    X3=X+RX
  121.    Y3=Y+RY
  122.    Z3=Z+RZ
  123.    Add Z3,128
  124.    Rol.l 9,X3
  125.    Rol.l 8,Y3
  126.    X3=X3/Z3
  127.    Y3=Y3/Z3
  128.    Add X3,CX
  129.    Add Y3,CY
  130.    '
  131.    If C=1 Then Gr Locate X3,Y3
  132.    '
  133.    If C=2 Then Draw To X3,Y3
  134.    '
  135.    C=Leek(Q)
  136.    Add Q,4
  137. Wend 
  138. Return 
  139. '
  140. SET_SCREEN:
  141. Colour 0,$F00
  142. Colour Back $F00
  143. Set Rainbow 0,0,144,"(9,-1,16)","","(9,1,16)"
  144. Rainbow 0,9,Y Hard(0,0),128
  145. Set Rainbow 1,0,80,"(5,1,16)","",""
  146. Rainbow 1,0,Y Hard(0,128),73
  147. Draw 0,127 To 640,127
  148. Draw To 400,100
  149. Draw To 300,10
  150. Draw To 200,80
  151. Draw To 0,127
  152. Return 
  153. '  
  154. CREATE_OBJECT:
  155. OBJECT$=Space$(400)
  156. O=Varptr(OBJECT$)
  157. Restore DT_3D
  158. Read A
  159. While A
  160.    Loke O,A
  161.    Add O,4
  162.    Read B
  163.    Loke O,B
  164.    Add O,4
  165.    Read C
  166.    Loke O,C
  167.    Add O,4
  168.    Read D
  169.    Loke O,D
  170.    Add O,4
  171.    Read A
  172. Wend 
  173. Loke O,A
  174. Return 
  175. '  
  176. DT_3D:
  177. Data 1,-100,-100,100
  178. Data 2,-100,100,100
  179. Data 2,100,100,100
  180. Data 2,100,-100,100
  181. Data 2,-100,-100,100
  182. Data 2,-100,-100,-100
  183. Data 2,-100,100,-100
  184. Data 2,-100,100,100
  185. Data 1,100,-100,100
  186. Data 2,100,-100,-100
  187. Data 2,100,100,-100
  188. Data 2,100,100,100
  189. Data 1,100,-100,-100
  190. Data 2,-100,-100,-100
  191. Data 1,100,100,-100
  192. Data 2,-100,100,-100
  193. Data 0